perm filename PERM[1,JMC] blob
sn#005211 filedate 1969-10-15 generic text, type T, neo UTF8
00100 (DE MA (CYC D) (COND ((NULL CYC) D) (T (MA1 (CAR CYC)
00200 CYC D))))
00300
00400 (DE MA1 (X U D) (COND ((NULL U) D) ((EQUAL (CAR U) D)
00500 (COND ((NULL (CDR U)) X) (T (CADR U)))) (T (MA1 X (CDR
00600 U) D))))
00700
00800 (DE MB (PERM D) (COND ((NULL PERM) D) (T (MA (CAR PERM)
00900 (MB (CDR PERM) D)))))
01000
01100 (DE UNION (U V) (COND ((NULL U) V) ((MEMBER (CAR U) V)
01200 (UNION (CDR U) V)) (T (CONS (CAR U) (UNION (CDR U) V)))))
01300
01400 (DE DIGS (P V) (COND ((NULL P) V) (T (DIGS (CDR P)
01500 (UNION (CAR P) V)))))
01600
01700 (DE PRODA (P1 P2) (PA (APPEND P1 P2) (DIGS P2 (DIGS P1
01800 NIL))))
01900
02000 (DE PA (U V) (COND ((NULL V) NIL) (T ((LAMBDA (W)
02100 (COND ((NULL W) (PA U (CDR V))) (T (CONS W (PA U (SSUB V W))))))
02200 (PB (CAR V) U)))))
02300
02400 (DE PB (X U) ((LAMBDA (Y) (COND ((EQUAL Y X) NIL)
02500 (T (CONS X (PC X Y U))))) (MB U X)))
02600
02700 (DE PC (X Y U) (COND ((EQUAL Y X) NIL) (T (CONS Y
03100 (PC X (MB U Y) U)))))
03200
03300 (DE SSUB (X Y) (COND ((NULL X) NIL) ((MEMBER (CAR X) Y)
03400 (SSUB (CDR X) Y)) (T (CONS (CAR X) (SSUB (CDR X) Y)))))
03500
03600 (DE PROD (P1 P2) ((LAMBDA (W) (COND ((NULL W) NIL)
03700 ((NULL (CDR W)) (CAR W)) (T W))) (PRODA (PRODB P1) (PRODB P2))))
03800
03900 (DE PRODB (P) (COND ((NULL P) NIL) ((ATOM (CAR P))
04000 (LIST P)) (T P)))
04100
04200 (DE INV (P) (COND ((NULL P) NIL)
04300 ((ATOM (CAR P)) (REVERSE P))
04400 (T (MAPLIST (FUNCTION (LAMBDA (X)
04500 (REVERSE (CAR X)))) P))))
04600
04700 (DE SPRODA (U V Y) (COND ((NULL U) Y)
04800 (T (SPRODA (CDR U) V (SPRODB (CAR U) V Y)))))
04900
05000 (DE SPRODB (X V Y) (COND ((NULL V) Y)
05100 (T (SPRODB X (CDR V) (CONS (PROD X (CAR V)) Y)))))
05200
05300 (DE RA (U V) (COND ((NULL U) V) (T (RA (CDR U)
05400 (CONS (CAR U) V)))))
05500
05600 (DE ROT (W) (COND ((OR (NULL W) (NULL (CDR W))) W)
05700 (T (ROTA (CAR W) (LIST (CAR W)) NIL (CDR W)))))
05800
05900 (DE ROTA (X U V W) (COND ((NULL W) (RA U (RA V NIL)))
06000 ((LESSP X (CAR W)) (ROTA X (CONS (CAR W) U) V (CDR W)))
06100 (T (ROTA (CAR W) (LIST (CAR W)) (APPEND U V) (CDR W)))))